\ Need to require string words for them to be available!
require string.fs


: not 0= ;

: rotate-5 ( n1 n2 n3 n4 n5 -- n2 n3 n4 n5 n1 )
  { a b c d e }
  b c d e a ;

: -rotate-5 ( n1 n2 n3 n4 n5 -- n2 n3 n4 n5 n1 )
  { a b c d e }
  e a b c d ;

: 4dup ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 n3 n4 )
  { a b c d }
  a b c d a b c d ;

: 4drop ( n1 n2 n3 n4 -- )
  2drop 2drop ;


: rock s" A" ;
: paper s" B" ;
: scissors s" C" ;
: lose s" X" ;
: draw s" Y" ;
: win s" Z" ;

: rock? ( c-addr len -- c-addr len flag )
  2dup rock compare 0= ;
: paper? ( c-addr len -- c-addr len flag )
  2dup paper compare 0= ;
: scissors? ( c-addr len -- c-addr len flag )
  2dup scissors compare 0= ;

: rock-score 1 ;
: paper-score 2 ;
: scissors-score 3 ;

: loss-score 0 ;
: draw-score 3 ;
: win-score 6 ;


: make-winning-move ( c-addr len -- c-addr len c-addr len )
  rock? if
    paper
  else
    paper? if
      scissors
    else
      scissors? if
        rock
      then
    then
  then ;

\ tests
rock make-winning-move paper compare throw 2drop
paper make-winning-move scissors compare throw 2drop
scissors make-winning-move rock compare throw 2drop

: make-drawing-move ( c-addr len -- c-addr len c-addr len )
  rock? if rock else
  paper? if paper else
  scissors? if scissors then then then ;

\ tests
rock make-drawing-move rock compare throw 2drop
paper make-drawing-move paper compare throw 2drop
scissors make-drawing-move scissors compare throw 2drop

: make-losing-move ( c-addr len -- c-addr len c-addr len )
  rock? if scissors else
  paper? if rock else
  scissors? if paper then then then ;

\ tests
rock make-losing-move scissors compare throw 2drop
paper make-losing-move rock compare throw 2drop
scissors make-losing-move paper compare throw 2drop

: make-losing-move? ( c-addr len -- c-addr len flag )
  2dup  \ c-addr len c-addr len
  lose  \ c-addr len c-addr len c-addr len
  compare  \ c-addr len flag
  0=  \ c-addr len flag
  ;
: make-drawing-move? ( c-addr len -- c-addr len flag )
  2dup draw compare 0= ;
: make-winning-move? ( c-addr len -- c-addr len flag )
  2dup win compare 0= ;

\ tests
win make-winning-move? 0= throw 2drop
win make-drawing-move? throw 2drop
win make-losing-move? throw 2drop
draw make-winning-move? throw 2drop
draw make-drawing-move? 0= throw 2drop
draw make-losing-move? throw 2drop
lose make-winning-move? throw 2drop
lose make-losing-move? 0= throw 2drop
lose make-drawing-move? throw 2drop

: draw? ( str len str len -- str len str len flag )
  compare 0= ;

\ tests
rock rock draw? 0= throw
paper paper draw? 0= throw
scissors scissors draw? 0= throw

: win? ( str len str len -- str len str len flag )
  4dup rock? -rot 2drop -rot scissors? -rot 2drop and -rotate-5
  4dup paper? -rot 2drop -rot rock? -rot 2drop and -rotate-5
  scissors? -rot 2drop -rot paper? -rot 2drop and
  or or ;

\ tests
rock paper win? 0= throw
rock rock win? throw
rock scissors win? throw
paper scissors win? 0= throw
paper paper win? throw
paper rock win? throw
scissors rock win? 0= throw
scissors scissors win? throw
scissors paper win? throw

: make-move ( oppo-str len advice-str len -- oppo-str len played-str len )
  make-losing-move?  \ oppo-str len advice-str len flag
  if  \ oppo-str len advice-str len
    2drop make-losing-move
  else
    make-drawing-move?
    if
      2drop make-drawing-move
    else
      make-winning-move?
      if
        2drop make-winning-move
      then
    then
  then ;

\ tests
rock win make-move paper compare throw 2drop
rock draw make-move rock compare throw 2drop
rock lose make-move scissors compare throw 2drop

paper win make-move scissors compare throw 2drop
paper draw make-move paper compare throw 2drop
paper lose make-move rock compare throw 2drop

scissors win make-move rock compare throw 2drop
scissors draw make-move scissors compare throw 2drop
scissors lose make-move paper compare throw 2drop

: score-for-move ( played-str len -- played-str len score)
  \ calculate score for move
  rock? if rock-score else
  paper? if paper-score else
  scissors? if scissors-score then then then ;

\ tests
rock score-for-move rock-score = 0= throw 2drop
paper score-for-move paper-score = 0= throw 2drop
scissors score-for-move scissors-score = 0= throw 2drop

: score ( oppo-str len advice-str len -- score )
  make-move
  \ calculate part of score for round result
  4dup draw?
  if
    3 -rotate-5
  else
    4dup win?
    if
      6 -rotate-5
    else
      0 -rotate-5
    then
  then
  score-for-move
  -rotate-5
  4drop + ;

\ tests
rock win score 8 = 0= throw
rock draw score 4 = 0= throw
rock lose score 3 = 0= throw
paper win score 9 = 0= throw
paper draw score 5 = 0= throw
paper lose score 1 = 0= throw
scissors win score 7 = 0= throw
scissors draw score 6 = 0= throw
scissors lose score 2 = 0= throw

8 Constant max-bytes-line
Create line-buffer max-bytes-line 2 + allot

: input-filename s" input" ;
input-filename r/o open-file throw Value puzzle-input-handle

: calculate-score ( c-addr length -- ??? )
  0  \ accumulator value for score
  begin puzzle-input-handle file-eof? not
  while
    \ read lines until the file has been completely processed
    line-buffer max-bytes-line puzzle-input-handle read-line throw  \ stack: acc length eof-flag

    \ check that everything was read OK from the line buffer
    swap dup 0 > rot and
    \ stack: acc length eof-flag
    \ stack: acc eof-flag length
    \ stack: acc eof-flag length length
    \ stack: acc eof-flag length length 0
    \ stack: acc eof-flag length length>0-flag
    \ stack: acc length length>0-flag eof-flag
    \ stack: acc length both-ok-flag
    if
      line-buffer swap  \ acc c-addr length
      \ split string into the 2 parts at the space character
      BL $split  \ acc c-addr-part-1 length-part-1 c-addr-part-2 length-part-2
      \ add up the score
      score +
    then
  repeat
  \ drop length of read characters from EOF read
  drop ;

calculate-score .

puzzle-input-handle close-file
